home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / HTML and CSS Modes / htmlDocumentUtils.tcl < prev    next >
Encoding:
Text File  |  2001-01-12  |  21.4 KB  |  609 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlDocumentUtils.tcl"
  6.  #                                    created: 99-07-20 17.17.35 
  7.  #                                last update: 01-01-01 20.45.55 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <alpha_www_tools@go.to>
  10.  #     www: <http://go.to/alpha_www_tools>
  11.  #  
  12.  # Version: 3.0
  13.  # 
  14.  # Copyright 1996-2001 by Johan Linde
  15.  #  
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # 
  30.  # ###################################################################
  31.  ##
  32.  
  33. #===============================================================================
  34. # This file contains procs for the menu items "New Document", "New with Content"
  35. # "New Doc. with Frames", "Document Size", "Document Type", and "Document Index"
  36. #===============================================================================
  37.  
  38. #===============================================================================
  39. # ◊◊◊◊ New document ◊◊◊◊ #
  40. #===============================================================================
  41.  
  42. #
  43. # Template for new file: HTML, TITLE, HEAD, BODY or FRAMESET
  44. # Optionally input BASE, LINK, ISINDEX, META and SCRIPT in HEAD.
  45. proc html::NewDocument {} {html::NewTemplate BODY}
  46. proc html::NewwithContent {} {html::NewTemplate BODY 1}
  47. proc html::NewDoc.withFrames {} {html::NewTemplate FRAMESET}
  48.  
  49. proc html::NewTemplate {doctype {withContent 0}} {
  50.     global htmlCurSel htmlIsSel HTMLmodeVars html::HeadElements html::HideExtensions html::HideDeprecated
  51.     global html::LastDocType html::LastFrameDocType html::LastNewHP html::LastNewTempl
  52.  
  53.     set indentHTML [lcontains HTMLmodeVars(indentElements) HTML]
  54.     set indentHEAD [lcontains HTMLmodeVars(indentElements) HEAD]
  55.     set indentBODY [lcontains HTMLmodeVars(indentElements) $doctype]
  56.     set headIndent ""
  57.     set bodyIndent ""
  58.     set htmlIndent ""
  59.     if {$indentHTML} {
  60.         append htmlIndent "\t"
  61.         append headIndent "\t"
  62.         append bodyIndent "\t"
  63.     }
  64.     if {$indentHEAD} {append headIndent "\t"}
  65.     if {$indentBODY} {append bodyIndent "\t"}
  66.     
  67.     if {![info exists html::LastNewHP]} {set html::LastNewHP " "}
  68.     if {![info exists html::LastNewTempl]} {set html::LastNewTempl " "}
  69.     
  70.     if {$doctype == "FRAMESET"} {
  71.         set htxt "New document with frames"
  72.     } else {
  73.         set htxt "New document"
  74.     }
  75.     
  76.     set box "-t {Choose template} 100 10 300 25 -t {Home Page:} 10 40 100 55 -t {Template:} 10 70 100 85"
  77.     set j 0
  78.     if {!$withContent} {
  79.         set fname ""
  80.         if {[llength [winNames]] && [html::IsEmptyFile]} {
  81.             set fname [stripNameCount [lindex [winNames] 0]]
  82.         }
  83.         append box " -t {File name:} 10 100 100 115 -e [list $fname] 110 100 340 115"; incr j
  84.     }
  85.     set hpflds ""
  86.     set sites ""
  87.     foreach hp $HTMLmodeVars(homePages) {
  88.         lappend hpflds [lindex $hp 0]
  89.         lappend sites "[lindex $hp 1][lindex $hp 2]"
  90.     }
  91.     lappend box -m [concat [list ${html::LastNewHP}] $sites] 110 40 350 60
  92.     set i 0
  93.     incr j 3
  94.     foreach hp $hpflds {
  95.         foreach f $HTMLmodeVars(templateFolders) {
  96.             if {[lindex $f 0] == $hp} {
  97.                 set tmpls($hp) {{ }}
  98.                 set tmplindex($hp) $j
  99.                 set tmplfld($hp) [lindex $f 1]
  100.                 incr j
  101.                 foreach t [glob -nocomplain -t TEXT -dir [lindex $f 1] *] {
  102.                     lappend tmpls($hp) [file tail $t]
  103.                 }
  104.                 lappend box -n [lindex $sites $i] -m [concat [list ${html::LastNewTempl}] $tmpls($hp)] 110 70 350 90
  105.                 break
  106.             }
  107.         }
  108.         incr i
  109.     }
  110.  
  111.     set values [eval [concat dialog -w 360 -h 160 -b OK 20 130 85 150 -b Cancel 110 130 175 150 $box]]
  112.     if {[lindex $values 1]} {return}
  113.     
  114.     set hpfld [lindex $hpflds [lsearch -exact $sites [set html::LastNewHP [lindex $values [expr {2 + !$withContent}]]]]]
  115.     if {[info exists tmpls($hpfld)] && [set html::LastNewTempl [lindex $values $tmplindex($hpfld)]] != " "} {
  116.         set template [file join $tmplfld($hpfld) ${html::LastNewTempl}]
  117.     }
  118.     
  119.     set bodyText ""
  120.     if {$withContent} {
  121.         set bodyText [getText [minPos] [maxPos]]
  122.         deleteText [minPos] [maxPos]
  123.     } else {
  124.         if {[set filename [string trim [lindex $values 2]]] == ""} {set filename Untitled.html}
  125.         if {![llength [winNames]] || ![html::IsEmptyFile] || [stripNameCount [lindex [winNames] 0]] != $filename} {
  126.             new -n $filename -m HTML
  127.         }
  128.     } 
  129.     
  130.     if {$indentHTML || $indentBODY} {regsub -all "\r" "\r$bodyText" "\r$bodyIndent" bodyText}
  131.     
  132.     if {[info exists template]} {
  133.         if {[catch {file::readAll $template} templText]} {
  134.             alertnote "Could not read template file."
  135.         } else {
  136.             insertText $templText
  137.         }
  138.     }
  139.     
  140.     if {![catch {search -s -f 1 -r 0 -i 1 -m 0 {#CONTENT#} [minPos]} res]} {
  141.         replaceText [lindex $res 0] [lindex $res 1] $bodyText
  142.     } elseif {![catch {search -s -f 1 -r 0 -i 1 -m 0 [html::CloseElem $doctype] [minPos]} res] || 
  143.       ![catch {search -s -f 1 -r 0 -i 1 -m 0 {</HTML>} [minPos]} res]} {
  144.         goto [lindex $res 0]
  145.         elec::Insertion $bodyText "\r\r"
  146.     } else {
  147.         goto [maxPos]
  148.         elec::Insertion $bodyText "\r\r$htmlIndent[html::CloseElem $doctype]\r\r[html::CloseElem HTML]"
  149.     }
  150.     
  151.     set docTitle ""
  152.     if {![catch {html::FindFirstOccurance {<title[^<>]*>[^<>]*</title>} [minPos]} res]} {
  153.         regexp -nocase {<title[^<>]*>([^<>]*)</title>} [eval getText $res] "" docTitle
  154.     }
  155.         
  156.     
  157.     set inHead "0 0 [list $docTitle]"
  158.     foreach elem ${html::HeadElements} {
  159.         lappend inHead 0
  160.     }
  161.     if {[set dt [html::FindDoctype]] != ""} {
  162.         switch $dt {
  163.             transitional -
  164.             frameset {lappend inHead 0 1 0}
  165.             strict {lappend inHead 0 0 1}
  166.         }
  167.     } elseif {$doctype == "BODY" && [info exists html::LastDocType]} {
  168.         lappend inHead [expr {${html::LastDocType} == "none"}] \
  169.           [expr {${html::LastDocType} == " Transitional"}] \
  170.           [expr {${html::LastDocType} == ""}]
  171.     } elseif {$doctype == "FRAMESET" && [info exists html::LastFrameDocType]} {
  172.         lappend inHead [expr {${html::LastFrameDocType} == "none"}] \
  173.           [expr {${html::LastFrameDocType} == " Frameset"}]
  174.     } else {
  175.         lappend inHead 0 1 0
  176.     }
  177.     set first 1
  178.     while {$first || $docTitle == ""} {
  179.         set first 0
  180.         # Construct the dialog box.
  181.         set box "-t [list $htxt] 100 10 300 25 -p 100 30 250 31 -t {TITLE} 10 40 60 55 \
  182.         -e [list [lindex $inHead 2]] 70 40 390 55 \
  183.         -t {Select the elements you want in the document\'s HEAD} 10 70 390 85"
  184.         set hpos 100
  185.         set wpos 10
  186.         set i 3
  187.         foreach elem ${html::HeadElements} {
  188.             append box " -c $elem [lindex $inHead $i] $wpos $hpos [expr {$wpos + 100}] [expr {$hpos + 15}]"
  189.             incr wpos 100
  190.             if {$wpos > 110} {set wpos 10; incr hpos 20}
  191.             incr i
  192.         }
  193.         if {$wpos > 10} {incr hpos 20}
  194.         incr hpos 10
  195.         append box " -t {Document type declaration:} 220 100 405 115"
  196.         append box " -r None [lindex $inHead $i] 220 120 390 135"
  197.         if {$doctype == "BODY"} {
  198.             append box " -r Transitional [lindex $inHead [expr {$i + 1}]] 220 140 390 155"
  199.             append box " -r Strict [lindex $inHead [expr {$i + 2}]] 220 160 390 175"
  200.         } else {
  201.             append box " -r Frameset [lindex $inHead [expr {$i + 1}]] 220 140 390 155"
  202.         }
  203.         set inHead [eval [concat dialog -w 410 -h [expr {$hpos + 30}] \
  204.         -b OK 20 $hpos 85 [expr {$hpos + 20}] \
  205.         -b Cancel 110 $hpos 175 [expr {$hpos + 20}] $box]]
  206.         if {[lindex $inHead 1]} {return}
  207.         set docTitle [string trim [lindex $inHead 2]]
  208.         if {$docTitle == ""} {
  209.             alertnote "A document title is required."
  210.         }
  211.     }
  212.     
  213.     if {![lindex $inHead $i]} {
  214.         if {$doctype == "BODY"} {
  215.             if {[lindex $inHead [expr {$i + 1}]]} {set dtd " Transitional"; set html::HideExtensions 1}
  216.             if {[lindex $inHead [expr {$i + 2}]]} {set dtd ""; set html::HideDeprecated 1}
  217.         } else {
  218.             set dtd " Frameset"
  219.         }
  220.         html::SetDis
  221.         set text "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01$dtd//EN\">\r"
  222.         if {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!doctype[^<>]+>} [minPos]} res]} {
  223.             replaceText [lindex $res 0] [lindex $res 1] $text
  224.         } else {
  225.             goto [minPos]
  226.             insertText $text "\r"
  227.         }
  228.         if {$doctype == "BODY"} {
  229.             set html::LastDocType $dtd
  230.         } else {
  231.             set html::LastFrameDocType $dtd
  232.         }
  233.     } else {
  234.         if {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!doctype[^<>]+>} [minPos]} res]} {
  235.             eval deleteText $res
  236.         }
  237.         if {$doctype == "BODY"} {        
  238.             set html::LastDocType none
  239.         } else {
  240.             set html::LastFrameDocType none
  241.         }
  242.     }
  243.     set pos [minPos]
  244.     if {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!doctype[^<>]+>} [minPos]} res]} {
  245.         set pos [lindex $res 1]
  246.         if {[is::Whitespace [getText $pos [nextLineStart $pos]]]} {set pos [nextLineStart $pos]}
  247.     }
  248.     if {![catch {html::FindFirstOccurance {<html[^<>]*>} $pos} res]} {
  249.         goto [lindex $res 0]
  250.         html::EditTag 1
  251.         set pos [lindex $res 1]
  252.     } else {
  253.         goto $pos
  254.         insertText [html::OpenElem HTML "" 0] "\r"
  255.         set pos [getPos]
  256.     }
  257.     if {![catch {html::FindFirstOccurance {<head[^<>]*>} $pos} res]} {
  258.         goto [lindex $res 0]
  259.         html::EditTag 1
  260.         set pos [lindex $res 1]
  261.     } else {
  262.         goto $pos
  263.         elec::Insertion $htmlIndent [html::OpenElem HEAD "" 0] "\r"
  264.         set pos [getPos]
  265.     }
  266.     if {![catch {html::FindFirstOccurance {<title[^<>]*>[^<>]*</title>} $pos} res]} {
  267.         regsub -nocase "(<title\[^<>\]*>)\[^<>\]*(</title>)" [eval getText $res] "\\1$docTitle\\2" dt
  268.         replaceText [lindex $res 0] [lindex $res 1] $dt
  269.         goto [lindex $res 0]
  270.         html::EditTag 1
  271.         set pos [lindex [html::FindFirstOccurance "</title>" $pos] 1]
  272.     } else {
  273.         goto $pos
  274.         insertText $docTitle
  275.         select $pos [pos::math $pos + [string length $docTitle]]
  276.         html::Tag TITLE
  277.         set pos [getPos]
  278.     }
  279.     if {[catch {html::FindFirstOccurance {</head>} $pos} res]} {
  280.         while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  281.             set tagtxt [eval getText $res]
  282.             if {$tagtxt == "<!--"} {
  283.                 # Comment
  284.                 if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} [lindex $res 0]} res]} {
  285.                     set pos [lindex $res 1]
  286.                 } else {
  287.                     set pos [maxPos]
  288.                 }
  289.                 continue
  290.             }
  291.             if {![regexp -nocase "<([join ${html::HeadElements} |]|/SCRIPT|/STYLE|/OBJECT)(\[ \t\r\n\]+|>)" $tagtxt]} {break}
  292.             set pos [lindex $res 1]
  293.         }
  294.         if {[is::Whitespace [getText $pos [nextLineStart $pos]]]} {set pos [nextLineStart $pos]}
  295.         goto $pos
  296.         elec::Insertion "\r" $htmlIndent [html::CloseElem HEAD] "\r"
  297.     }
  298.     
  299.     for {set i 0} {$i < [llength  ${html::HeadElements}]} {incr i} {
  300.         if {[lindex $inHead [expr {$i + 3}]]} {
  301.             set he [lindex ${html::HeadElements} $i]
  302.             if {$he == "ISINDEX" && $dtd == ""} {alertnote "ISINDEX cannot be used in strict HTML."; continue}
  303.             if {($he == "ISINDEX" || $he == "BASE") && ![catch {html::FindFirstOccurance "<$he\[^<>\]*>" [minPos]} res]} {
  304.                 goto [lindex $res 0]
  305.                 html::EditTag 1
  306.             } else {
  307.                 set pos [lindex [html::FindFirstOccurance {</head>} [minPos]] 0]
  308.                 goto $pos
  309.                 html::Tag $he                
  310.                 if {($he == "STYLE" || $he == "SCRIPT" || $he == "OBJECT") && $HTMLmodeVars(useTabMarks)} {
  311.                     insertText •
  312.                     catch {ring::+}
  313.                 } 
  314.             }
  315.         }
  316.     }
  317.     
  318.     if {![catch {html::FindFirstOccurance "<$doctype\[^<>\]*>" [minPos]} res]} {
  319.         goto [lindex $res 0]
  320.         html::EditTag 1
  321.     } else {
  322.         set pos [lindex [html::FindFirstOccurance {</head>} [minPos]] 1]
  323.         if {[is::Whitespace [getText $pos [nextLineStart $pos]]]} {set pos [nextLineStart $pos]}
  324.         goto $pos
  325.         elec::Insertion "\r" $htmlIndent [html::OpenElem $doctype "" 0] "\r"
  326.     }
  327.     refresh
  328.     html::ActivateHook
  329.     goto [minPos]
  330.     ring::+
  331. }
  332.  
  333. #===============================================================================
  334. # ◊◊◊◊ Document type ◊◊◊◊ #
  335. #===============================================================================
  336.  
  337. proc html::DocumentType {} {
  338.     set dt [html::FindDoctype]
  339.     set m0 [lindex [set types {Strict Strict Transitional Frameset}] [lsearch -exact {{} strict transitional frameset} $dt]]
  340.     set v [dialog -w 200 -h 120 -t "Document type declaration" 10 10 190 30 \
  341.       -m [concat $m0 [lrange $types 1 end]] 10 50 190 70 -b OK 20 90 85 110 -b Cancel 105 90 170 110]
  342.     if {[lindex $v 2]} {return}
  343.     set pos [pos::diff [getPos] [minPos]]
  344.     goto [minPos]
  345.     switch [lindex $v 0] {
  346.         Strict {set dtd {}}
  347.         Transitional {set dtd " Transitional"}
  348.         Frameset {set dtd " Frameset"}
  349.     }
  350.     set txt "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01$dtd//EN\">"
  351.     if {![catch {search -s -f 1 -i 1 -m 0 -r 1 {<!DOCTYPE[^<>]+>} [minPos]} res]} {
  352.         eval deleteText $res
  353.     } else {
  354.         set res "[minPos] [minPos]"
  355.     }
  356.     insertText $txt [html::CloseCR]
  357.     goto [pos::math [minPos] + $pos + [string length $txt] - [pos::diff [lindex $res 0] [lindex $res 1]]]
  358.     html::ActivateHook
  359. }
  360.  
  361. #===============================================================================
  362. # ◊◊◊◊ Document size ◊◊◊◊ #
  363. #===============================================================================
  364.  
  365. # Calculate the total size of a document including images etc.
  366. proc html::DocumentSize {} {
  367.     # Get path to this window.
  368.     if {[set thisURL [html::ThisFilePath 3]] == ""} {return}
  369.     set exp1 {<!--|[ \t\n\r]+(DATA|CLASSID|SRC|LOWSRC|DYNSRC|BACKGROUND|USEMAP)[ \t\n\r]*=[ \t\n\r]*("[^"]+"|'[^']+'|[^ \t\n\r"'>]+)}
  370.     set exp2 {[ \t\r\n]+(url)\([ \t\r\n]*("[^"]+"|'[^']+'|[^ \t\n\r"'\)]+)[ \t\r\n]*\)}
  371.     set commStart1 "<!--"
  372.     set commEnd1 "-->"
  373.     set commStart2 {/*}
  374.     set commEnd2 {*/}
  375.     set size 0
  376.     set counted {}
  377.     set external 0
  378.     set notfound 0
  379.     for {set i 1} {$i < 3} {incr i} {
  380.         set pos [minPos]
  381.         set exp [set exp$i]
  382.         set commStart [set commStart$i]
  383.         set commEnd [set commEnd$i]
  384.         while {![catch {search -s -f 1 -i 1 -m 0 -r 1 $exp $pos} res]} {
  385.             set restxt [eval getText $res]
  386.             # Comment?
  387.             if {$restxt == $commStart} {
  388.                 if {![catch {search -s -f 1 -m 0 -i 0 -r 0 -- $commEnd [lindex $res 1]} res]} {
  389.                     set pos [lindex $res 1]
  390.                     continue
  391.                 } else {
  392.                     break
  393.                 }
  394.             }
  395.             # Get path to link.
  396.             regexp -nocase $exp $restxt dum1 dum2 linkTo
  397.             set linkTo [html::URLunEscape [string trim $linkTo "\"' \t\r\n"]]
  398.             if {[string index $linkTo 0] != "#"} {
  399.                 if {![catch {lindex [html::PathToFile [lindex $thisURL 0] [lindex $thisURL 1] [lindex $thisURL 2] [lindex $thisURL 3] $linkTo] 0} linkToPath]} {
  400.                     if {[file exists $linkToPath] && ![file isdirectory $linkToPath]} {
  401.                         if {![lcontains counted $linkToPath]} {
  402.                             getFileInfo $linkToPath arr
  403.                             incr size $arr(datalen)
  404.                             lappend counted $linkToPath
  405.                         }
  406.                     } else {
  407.                         set notfound 1
  408.                     }
  409.                 } else {
  410.                     set external 1
  411.                 }
  412.             }
  413.             set pos [lindex $res 1]
  414.         }
  415.     }
  416.     incr size [pos::diff [maxPos] [minPos]]
  417.     if {$size > 1000} {
  418.         set size "[expr {$size /1024}] kB"
  419.     } else {
  420.         append size " bytes"
  421.     }
  422.     set txt "Total size: $size."
  423.     if {$notfound} {append etxt "Some files not found. "}
  424.     if {$external} {append etxt "External sources excluded."}
  425.     if {$notfound || $external} {append txt " ([string trim $etxt])"}
  426.     alertnote $txt
  427. }
  428.  
  429.  
  430. #===============================================================================
  431. # ◊◊◊◊  Document index ◊◊◊◊ #
  432. #===============================================================================
  433.  
  434. proc html::DocumentIndex {} {
  435.     global HTMLmodeVars
  436.     
  437.     set liIndent ""
  438.     set indLists [lcontains HTMLmodeVars(indentElements) UL]
  439.     set indItems [lcontains HTMLmodeVars(indentElements) LI]
  440.     if {$indLists} {set liIndent "\t"}
  441.     html::indentCR UL LI
  442.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r\n]+#DOCINDEX[ \t\r\n]+[^>]+>} [minPos]} begin] &&
  443.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r\n]+/#DOCINDEX[ \t\r\n]+[^>]+>} [lindex $begin 1]} endind] &&
  444.     [regexp -nocase {TYPE=\"(UL|PRE,[0-9]+)\"} [getText [lindex $begin 0] [lindex $begin 1]] dum type]} {
  445.         if {![regexp -nocase {DEPTH=\"([1-6])\"} [getText [lindex $begin 0] [lindex $begin 1]] dum depth]} {set depth 6}
  446.         set type [string toupper $type]
  447.         if {$type != "UL"} {
  448.             regexp {(PRE),([0-9]+)} $type dum type indent
  449.             set indStr [string range "                                  " 1 $indent]
  450.         }
  451.         set replace 1
  452.     } else {
  453.         set replace 0
  454.         set values [list 0 0 6 PRE 3]
  455.         while {1} {
  456.             set box "-t {Document index} 50 10 250 30 \
  457.             -t {Header depth} 10 40 100 60 -e [list [lindex $values 2]] 105 40 125 55 \
  458.             -m {[list [lindex $values 3]] PRE UL} 10 65 60 85 \
  459.             -n PRE -t Indent 70 65 120 85 -e [list [lindex $values 4]] 125 65 165 80 \
  460.             -t characters 170 65 290 85"
  461.             set values [eval [concat dialog -w 300 -h 130 -b OK 20 100 85 120 -b Cancel 110 100 175 120 $box]]
  462.             set depth [lindex $values 2]
  463.             set type [lindex $values 3]
  464.             if {[lindex $values 1]} {return}
  465.             if {[expr {($depth > 0) && ($depth < 7)}]} {
  466.                 if {$type == "PRE"} {
  467.                     set indent [lindex $values 4]
  468.                     if {[is::PositiveInteger $indent]} {
  469.                         set indStr [string range "                                  " 1 $indent]
  470.                         break
  471.                 } else {
  472.                     alertnote "The number of characters to indent must be specified."
  473.                 }
  474.                 } else {
  475.                     break
  476.                 }
  477.             } else {
  478.                 alertnote "The header depth must be between 1 and 6"
  479.             }
  480.         }
  481.  
  482.     }
  483.  
  484.     set pos [minPos]
  485.     set exp "<\[Hh\]\[1-$depth\]\[^<>\]*>"
  486.     set exp2 "</\[Hh\]\[1-$depth\]>"
  487.     set indLevel 1
  488.     set headSize 0
  489.     set toc "\r\r<[html::SetCase $type]>"
  490.     set cr 0
  491.     set curr ""
  492.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp $pos} rs] && 
  493.     ![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp2 [lindex $rs 1]} res]} {
  494.         set start [lindex $rs 0]
  495.         set end [lindex $res 1]
  496.         set text [getText $start $end]
  497.         set thisSize [getText [pos::math $start + 2] [pos::math $start + 3]]
  498.         set text2 [getText [lindex $rs 1] [lindex $res 0]]
  499.         regsub -all "\[\t\r\n\]+" $text " " text
  500.         # remove all tags from text
  501.         set headtext [string trim [html::TagStrip $text]]
  502.         # Remove " from text.
  503.         regsub -all "\"" $headtext "" headtext
  504.         # Check if there is already an anchor
  505.         if {[regexp -nocase {<A[ \t\r\n]+[^<>]*NAME[ \t\r\n]*=[ \t\r\n]*(\"[^\">]+\"|'[^'>]+'|[^ \t\n\r>]+)} $text2 dum anchor]} {
  506.             set anchor [string trim $anchor "\"'"]
  507.         } else {
  508.             # Insert an anchor
  509.             set anchor [string trim [string range $headtext 0 15]]
  510.             # Make sure a &xxx; is not chopped.
  511.             if {[set amp [string last & $anchor]] > [set semi [string last \; $anchor]]} {
  512.                 set rest [string range $headtext 16 end]
  513.                 append anchor [string range $rest 0 [string first \; $rest]]
  514.             }
  515.             # Is there an <A> tag?
  516.             if {[regexp -nocase -indices {<A([ \t\r\n]+[^<>]+>|>)} $text2 atag]} {
  517.                 set text3 " [html::SetCase NAME]=\"$anchor\""
  518.                 replaceText [set blah [pos::math [lindex $rs 1] + [lindex $atag 0] + 2]] $blah $text3
  519.                 set end [pos::math $end + [string length $text3]]
  520.             } else {
  521.                 set text3 "<[html::SetCase {A NAME}]=\"$anchor\">$text2[html::CloseElem A]"
  522.                 replaceText [lindex $rs 1] [lindex $res 0] $text3
  523.                 set end [pos::math $end + [string length $text3] - [string length $text2]]
  524.             }
  525.         }
  526.         
  527.         if {!$headSize} {
  528.             # first header
  529.             set headSize $thisSize
  530.         } elseif {$thisSize > $headSize && $headSize} {
  531.             # new list
  532.             for {set i $headSize} {$i < $thisSize} {incr i} { 
  533.                 if {$type == "UL"} {
  534.                     html::crBefore $blBefUL $crBefUL toc $liIndent cr curr [html::SetCase <UL>]
  535.                     html::crAfter $blAftUL $crAftUL toc liIndent cr curr 0 $indLists
  536.                 }
  537.             }
  538.             incr indLevel [expr {$thisSize - $headSize}]
  539.             set headSize $thisSize
  540.         } elseif {$thisSize < $headSize && $indLevel} {
  541.             # close a list
  542.             for {set i $thisSize} {$i < $headSize && $indLevel > 1} {incr i} {
  543.                 if {$type == "UL"} {
  544.                     html::crBefore ${blBef/UL} ${crBef/UL} toc $liIndent cr curr [html::CloseElem UL]
  545.                     html::crAfter ${blAft/UL} ${crAft/UL} toc liIndent cr curr 1 $indLists
  546.                 }
  547.                 incr indLevel -1
  548.             }
  549.             set headSize $thisSize
  550.         }
  551.         if {$type == "UL"} {
  552.             html::crBefore $blBefLI $crBefLI toc $liIndent cr curr [html::SetCase <LI>]
  553.             html::crAfter $blAftLI $crAftLI toc liIndent cr curr 0 $indItems
  554.         } else {
  555.             append toc \r
  556.             for {set i 1} {$i < $indLevel} {incr i} {
  557.                 append toc $indStr
  558.             }
  559.         }
  560.         if {$type == "UL"} {
  561.             append curr [html::prepareForBreaking "[html::SetCase {<A HREF}]=\"#$anchor\">$headtext[html::CloseElem A]"]
  562.         } else {
  563.             append toc "[html::SetCase {<A HREF}]=\"#$anchor\">$headtext[html::CloseElem A]"
  564.         }
  565.         if {$type == "UL" && [lcontains HTMLmodeVars(optionalClosing) LI]} {
  566.             html::crBefore ${blBef/LI} ${crBef/LI} toc $liIndent cr curr [html::CloseElem LI]
  567.             html::crAfter ${blAft/LI} ${crAft/LI} toc liIndent cr curr 1 $indItems
  568.         }
  569.         set pos $end
  570.     }
  571.     if {$type == "UL"} {
  572.         for {set i $indLevel} {$i > 0} {incr i -1} {
  573.             html::crBefore ${blBef/UL} ${crBef/UL} toc $liIndent cr curr [html::CloseElem UL]
  574.             html::crAfter ${blAft/UL} ${crAft/UL} toc liIndent cr curr 1 $indLists
  575.         }
  576.         if {$curr != ""} {
  577.             if {![is::Whitespace $curr]} {append toc $liIndent}
  578.             append toc [html::BreakIntoLines $curr $liIndent]
  579.         }
  580.     } else {
  581.         append toc "\r[html::CloseElem PRE]\r\r"
  582.     }
  583.     if {$replace} {
  584.         if {[pos::compare $pos == [minPos]]} {set toc ""}
  585.         # Find list again in case it has moved.
  586.         set begin [search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r\n]+#DOCINDEX[ \t\r\n]+[^>]+>} [minPos]]
  587.         set endind [search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r\n]+/#DOCINDEX[ \t\r\n]+[^>]+>} [lindex $begin 1]]
  588.         if {$type == "PRE"} {
  589.             replaceText  [lindex $begin 1] [lindex $endind 0] [string trimright $toc] \r\r
  590.         } else {
  591.             elec::ReplaceText [lindex $begin 1] [lindex $endind 0] [string trimright $toc] \r\r
  592.         }
  593.     } else {
  594.         set tt ""
  595.         if {[pos::compare $pos == [minPos]]} {alertnote "Empty index."; return}
  596.         if {$type == "PRE"} {
  597.             set tt ",$indent"
  598.             set ind ""
  599.         }
  600.         append toctext [html::OpenCR 1] [html::SetCase "<!-- #DOCINDEX TYPE=\"$type$tt\" DEPTH=\"$depth\" -->"] \
  601.           [string trimright $toc] \r\r [html::SetCase "<!-- /#DOCINDEX -->"] [html::CloseCR2 [getPos]]
  602.         if {$type == "PRE"} {
  603.             insertText $toctext
  604.         } else {
  605.             html::elecInsertion toctext
  606.         }
  607.     }
  608. }
  609.